home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / fortran.zip / TESTALL.FOR < prev    next >
Text File  |  1991-01-07  |  3KB  |  98 lines
  1. -   Program to test SBM Fortran compiler.
  2. /    exclude rtl
  3. -   Here we declare a character array and initialize it to whatever size the
  4. -   data requires.
  5.  
  6.     character outbuf/esc,'[2J',cr,lf,'            -- Testing ---',cr,lf
  7.     '1. UNFORMATTED OUTPUT: write(*) outbuf',cr,lf
  8.     '   (also data statement to set the output)',cr,lf,lf,0/
  9.     write(*) outbuf    ; display the array.
  10.  
  11.  data command/'now is the-time',0/
  12.     parse_only command,outbuf,'-'
  13.  
  14.     write(*,*) '2. This is LIST DIRECTED OUTPUT TO CONSOLE'
  15.     write(*,*) ''      ; line-feed
  16. -   now test formatted output.
  17.     integer*2 int2_1, int2_2, int2_3, int2_4, int2_5
  18. -   Since the variables were declared without any intervening data, they
  19. -   can be initialized as though they were an array.
  20.     data int2_1 /1,23,456,7890,32767/
  21.     write(*,1012) int2_1, int2_2, int2_3, int2_4, int2_5
  22. 1012 format('3. FORMATTED OUTPUT ',i2,i3,i4,i5, i30, ' maximum')
  23.  
  24. -   notice how we can insert long skips           ^.
  25. -   one should never need the 'x' descriptor on output.
  26. -   Standard fortran works this way too.
  27.  
  28. -   try some tricky subscripting and display max negative number.
  29.     data int2_5/-32768/
  30.     m=1
  31.     write(*,1012) int2_1(m), int2_2, int2_1(m+2), int2_5(m-1), int2_5
  32.     write(*,*) ''      ; xtra line-feed
  33.  
  34. -   disk output....
  35.     write(*,*) '4. Testing disk output.'
  36.     write(*,*) '   Do-loops are also tested here.'
  37.     open(16,file='testall.dat',status='new',alias=memfile)
  38.     if(cy) call exit
  39.     do 809 counter=1,10
  40.     write(16,309) counter
  41. 309 format('test output record',i3)
  42. 809 continue
  43.     write(*,*) '   10 records written to "testall.dat".'
  44.     close 16
  45.     write(*,*) '   "testall.dat" closed.'
  46.     write(*,*) ''      ; line-feed
  47.  
  48. -   appending disk data to an existing file.
  49.     open(17,file='e:testall.dat',status='append')
  50.     write(*,*) '   "testall.dat" re-opened for appending.'
  51.     do 909 counter=1,4
  52.     write(17,409) counter
  53. 409 format('appended record',i3)
  54. 909 continue
  55.     write(*,*) '    4 records appended.'
  56.     write(*,*) ''      ; line-feed
  57. --------------------------------------------------------
  58.  
  59. -   read from an internal file.
  60. -   also called a re-read.  with it you can read a record as many times
  61. -   as you wish, using a different format each time. above, notice that
  62. -   we assigned an alias to unit 16.  In this buffer area, we still have
  63. -   the last record that was written with format 309.
  64.  
  65.     integer lastnum
  66.     read(memfile,160) lastnum
  67. 160 format(19x,i3)
  68.     add lastnum,2000    ; test the 'add' statement.
  69.     write(*,161) lastnum
  70. 161 format('5. Reading from internal file, should be 2010, have',i5/)
  71.  
  72. -   using the dollar descriptor for console message.
  73.     write(*,*) 'press any key to continue  ',$
  74.  
  75. -   get next character from console
  76.     wait    (you could also use 'nexchar' here)
  77.     data outbuf/esc,'[2J',0/
  78.     write(*) outbuf  ; clear the screen
  79.  
  80.     write(*,*) '6. Testing assign statements and subscripts'
  81. -   also notice the nested 'do'.
  82.     data outbuf/'    abcdefghijklmnopqrstuvwxyz 0123456789',cr,lf,0/
  83.     counter=4
  84.     do 211 k=1,4
  85.     do 200 j=4,100
  86.     outbuf(j)=outbuf(j+1)
  87.     if(al.eq.0) goto 201
  88. 200 continue
  89. 201 write(*) outbuf
  90. 211 continue
  91.     write(*,*) ''      ; line-feed
  92.  
  93.     data outbuf/cr,lf,'       -- Testing Completed ---',cr,lf,lf,0/
  94.     write(*) outbuf
  95.     call exit
  96.     end
  97.  
  98.